perm filename RESTX.F4[MSS,LCS]1 blob sn#179206 filedate 1975-10-01 generic text, type T, neo UTF8
00100		SUBROUTINE RESTS(PN,Q)
00200		COMMON/STF/RSTFAC(-3/4),RSTJ2 /XXX/LK,LP,JY /XRN/RN(2000)
00500		COMMON RS,JA,REST,J2,RQ(18),JX,JR,LX,RDIS
00600		COMMON/POSI/STFF(-3/4),JJ2,PQ/PTR/PWDS(250),L,LL,I,IX
00650		DIMENSION PN(1),Q(1)
00700		EQUIVALENCE (RQ(10),XLFT),(R5,RQ(3)),(R6,RQ(4)),(R7,RQ(5))
00800	C  RQ(3) IS R5 ETC.
00900		XLFT=0
00910		SIG=-99
00955		CLEF=-99
01000		REST=0
01100		K=1
01200	50	JL=PN(K)
01300		R=Q(JL+1)
01400		IF(XLFT.NE.0)GO TO 2
01500		IF(R.LE.4)XLFT=Q(JL+3)
01510	CC8	IF(R.NE.4)GO TO 2
01514	CC	IF(Q(JL).GT.2)GO TO 231
01518	CC4	K=K+1
01522	CC	JL=PN(K)
01524	CC	R=Q(JL+1)
01526	CC	IF(R.NE.4)GO TO 2
01530	CC	IF(Q(JL).GT.2)GO TO 231
01534	CC	Q(JL+1)=-1
01538	C FOUND CONSEC. BARS
01542	CC	GO TO 4
01546	
01550	2	IF(R.NE.3)GO TO 5
01554		RR=Q(JL+5)
01558		IF(Q(JL).LT.3)RR=0
01562		IF(RR.EQ.CLEF)GO TO 60
01570		GO TO 3
01574	
01578	60	Q(JL+1)=-1
01582		GO TO 231
01586	5	IF(R.NE.17)GO TO 3
01590		IF(Q(JL+5).EQ.SIG)GO TO 60
01594		SIG=Q(JL+5)
01600	3	IF(R.NE.2)GO TO 231
01700		IF(Q(JL).LT.6)GO TO 231
01800	C FOUND A WHOLE REST MEAS.
01900		IF(REST.NE.0)GO TO 6
02000		JR=JL+8
02100	C  POINTER TO REST NUM.
02110		R=Q(JR-1)
02120		IF(R.LT.5)R=5
02200		Q(JR-1)=R*.6
02300	C  REDUCE SIZE OF REST'S TIME SO IT WILL TAKE LESS SPACE.
02400	6	REST=REST+1
02500		Q(JR)=REST
02600		JL=K+2
02700		IF(JL.GE.L)RETURN
02710	CC	LC=PN(K+1)
02755	CC	IF(Q(LC+1))JL=JL+1
02760	C WAS THERE AN EXTRA BAR?
02800		LB=PN(JL)
02900		IF(Q(LB+1).NE.2)GO TO 233
03000	C NEXT IS TO COMBINE MEASURES OF REST
03100		IF(Q(LB).LT.6)GO TO 233
03200	C  SKIP NON-WHOLE RESTS
03300		N=PN(JL-1)
03400		IF(Q(N+1).NE.4)GO TO 233
03500	C  IS REST FOLLOWED BY A BAR?
03700	C SO IT WON'T BE FOUND NEXT TIME AROUND.
03800		Q(LB+1)=-1
03900	C  CHANGE CODE #
04000		Q(N+1)=-1 
04100		K=JL
04200		GO TO 6
04300	
04400	233	REST=0
04500	231	K=K+1
04600		IF(K.LT.L)GO TO 50
04700		END
04800	
04900	
05000	CC	SUBROUTINE ADDRST(RPOS,XWDS,PN)
05100	CC	COMMON /XXX/LK,LP,JY /PTR/PWDS(250),L,LL,I,IX
05400	CC	COMMON RS,JA,REST,J2,RQ(18),JX,JR,LX,RDIS
05600	CC	DIMENSION XWDS(1),PN(1)
05900	CC	PN(LK)=6
06000	CC	PN(LK+1)=2
06100	CC	PN(LK+2)=RS
06200	CC	PN(LK+3)=RPOS-1.
06300	CC	PN(LK+4)=0   
06400	CC	PN(LK+5)=0   
06500	CC	PN(LK+6)=0   
06600	CC	PN(LK+7)=6.  
06700	CC	PN(LK+8)=-1
06800	CC	LK=LK+9
06900	CC	L=L+1
07000	CC	XWDS(L)=LK
07100	C NEXT ADDS A BAR LINE
07300	CC	PN(LK)=2
07400	CC	PN(LK+1)=4
07500	CC	PN(LK+2)=RS
07600	CC	PN(LK+3)=RPOS
07700	CC	PN(LK+4)=1.
07800	CC	LK=LK+5
07900	CC	L=L+1
08000	CC	XWDS(L)=LK
08200	CC	END